home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ogle.com / EYES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-09-04  |  6.9 KB  |  212 lines
  1. {$F+,R-}
  2. unit Eyes;
  3. interface
  4.  
  5. uses graph,mouse;
  6.  
  7. type EyeDataRec = record
  8.        BColor : byte;    {eye background color}
  9.        EColor : byte;    {eye rim color}
  10.        PColor : byte;    {pupil color}
  11.        Style  : integer; {eye style}
  12.        Xasp   : word;    {screen X aspect}
  13.        Yasp   : word;    {screen Y aspect}
  14.  
  15.        Exr   : integer; {Eyeball X range}
  16.        Eyr   : integer; {Eyeball Y range}
  17.        Bpsx  : integer; {Pupil X size}
  18.        Bpsy  : integer; {Pupil Y size}
  19.  
  20.        Lesx : integer; {Left eyeball X start pos}
  21.        Lesy : integer; {Left eyeball Y start pos}
  22.        Lecx : integer; {Left eyeball X center pos}
  23.        Lecy : integer; {Left eyeball Y center pos}
  24.        Leex : integer; {Left eyeball X end pos}
  25.        Leey : integer; {Left eyeball Y end pos}
  26.  
  27.        Resx : integer; {Right eyeball X start pos}
  28.        Resy : integer; {Right eyeball Y start pos}
  29.        Recx : integer; {Right eyeball X center pos}
  30.        Recy : integer; {Right eyeball Y center pos}
  31.        Reex : integer; {Right eyeball X end pos}
  32.        Reey : integer; {Right eyeball Y end pos}
  33.  
  34.        Pexl : integer; {Left eye X Position}
  35.        Peyl : integer; {Left eye Y Position}
  36.        Pexr : integer; {Right eye X Position}
  37.        Peyr : integer; {Right eye Y Position}
  38.        TPexl : integer; {Temp Left eye X Position}
  39.        TPeyl : integer; {Temp Left eye Y Position}
  40.        TPexr : integer; {Temp Right eye X Position}
  41.        TPeyr : integer; {Temp Right eye Y Position}
  42.  
  43.      end;
  44.  
  45.  
  46. procedure MakeEyes(var EyeData:EyeDataRec;
  47.                    Xp,Yp,Size,How:integer; Eye,Edge,Pupil:byte);
  48. procedure LookAt(var EyeData:EyeDataRec; Xp,Yp:integer);
  49.  
  50.  
  51. implementation
  52.  
  53.   {----------------------------------------------------}
  54.   {rounding divide. divides m into d and rounds up result}
  55.   function rdiv(d:longint; m:word):word;
  56.   Inline(
  57.     $5B        { pop bx}
  58.     /$58       { pop ax}
  59.     /$5A       { pop dx}
  60.     /$F7/$F3   { div bx}
  61.     /$01/$D2   { add dx,dx}
  62.     /$39/$D3   { cmp bx,dx}
  63.     /$73/$01   { jnc nornd}
  64.     /$40       { inc ax}
  65.             ); {nornd:}
  66.  
  67.  
  68.   {----------------------------------------------------}
  69.   function Limit(Value,Start,Stop:integer):integer;
  70.   Inline(
  71.     $58        { pop ax  ;Stop}
  72.     /$5B       { pop bx  ;Start}
  73.     /$59       { pop cx  ;Value}
  74.     /$39/$C1   { cmp cx,ax}
  75.     /$7F/$08   { JG done}
  76.     /$89/$D8   { mov ax,bx}
  77.     /$39/$C1   { cmp cx,ax}
  78.     /$7C/$02   { JL done}
  79.     /$89/$C8   { mov ax,cx}
  80.             ); {done:}
  81.  
  82.   {----------------------------------------------------}
  83.   {compute an integer based log2}
  84.   {$F+} function ILog2(Value:longint):word; external;
  85.   {$L INTLOG2}
  86.  
  87.  
  88.   {----------------------------------------------------}
  89.   {put the eyes on the screen in the location specified}
  90.   procedure MakeEyes(var EyeData:EyeDataRec;
  91.                      Xp,Yp,Size,How:integer; Eye,Edge,Pupil:byte);
  92.   begin
  93.     with EyeData do
  94.     begin
  95.       Style := How;                   {store away pattern info}
  96.       BColor := Eye;                  {and the colors}
  97.       EColor := Edge;
  98.       PColor := Pupil;
  99.  
  100.       GetAspectRatio(Xasp,Yasp);      {compute graphics eye X/Y size}
  101.       Eyr  := (Xasp*Size*2)div Yasp;  {adjusted for screen aspect ratio}
  102.       Exr  := Size;
  103.  
  104.       Lecx := Xp;
  105.       Lesx := Lecx-(Exr div 2);       {compute left eye parameters}
  106.       Leex := Lesx+Exr;
  107.       Lecy := Yp;
  108.       Lesy := Lecy-(Eyr div 2);
  109.       Leey := Lesy+Eyr;
  110.  
  111.       Recx := Xp+(Exr*3);             {compute right eye parameters}
  112.       Resx := Recx-(Exr div 2);
  113.       Reex := Resx+Exr;
  114.       Recy := Yp;
  115.       Resy := Recy-(Eyr div 2);
  116.       Reey := Resy+Eyr;
  117.  
  118.       Bpsx := Exr div 5;              {compute pupil X/Y size}
  119.       Bpsy := Eyr div 5;
  120.  
  121.       Pexl := Lecx;                   {default pupil start to center of eye}
  122.       Peyl := Lecy;
  123.       Pexr := Recx;
  124.       Peyr := Recy;
  125.  
  126.       HideMouse;                       {hide the mouse while we do this}
  127.       SetFillStyle(SolidFill,BColor);  {draw the eyes on the screen}
  128.       SetColor(EColor);
  129.       FillEllipse(Pexl,Peyl,Exr,Eyr);
  130.       FillEllipse(Pexr,Peyr,Exr,Eyr);
  131.  
  132.      { Rectangle(Lesx,Lesy,Leex,Leey); }  {show pupil work area}
  133.      { Rectangle(Resx,Resy,Reex,Reey); }  {  (for debugging) }
  134.  
  135.       SetFillStyle(Solidfill,PColor);   {now draw the pupils }
  136.       SetColor(PColor);                 {(Orphan Anney we ain't!)}
  137.       FillEllipse(Pexl,Peyl,Bpsx,Bpsy);
  138.       FillEllipse(Pexr,Peyr,Bpsx,Bpsy);
  139.       ShowMouse;                {all done, so let 'em have the mouse back}
  140.     end;
  141.   end;
  142.  
  143.  
  144.   {----------------------------------------------------}
  145.   {compute where the pupil is placed within the eye}
  146.   function Map(Style,Start,Center,Stop,Max:integer; Pos:longint):integer;
  147.   begin
  148.     case Style of
  149.       1: begin
  150.            if Pos-Center > 0 then  {compute scaled pupil X location}
  151.              Map := Center+rdiv((Stop-Center)*4,rdiv((Max-Center)*4,Pos-Center))
  152.            else if Pos-Center < 0 then
  153.              Map := Center-rdiv((Center-Start)*4,rdiv(Center*4,abs(Pos-Center)))
  154.            else Map := Center;
  155.          end;
  156.       2: begin
  157.            if (Pos-Center) > 0 then  {compute log2 pupil X location}
  158.            begin
  159.              Map := Center+rdiv(longint(ILog2(Pos-Center))*4,
  160.                            rdiv(longint(ILog2(Max-Center))*4,Stop-Center));
  161.            end
  162.            else if (Pos-Center) < 0 then
  163.            begin
  164.              Map := Center-rdiv(longint(ILog2(abs(Pos-Center)))*4,
  165.                            rdiv(longint(ILog2(Center))*4,Center-Start));
  166.            end
  167.            else Map := Center;
  168.          end;
  169.       else Map := Limit(integer(Pos),Start,Stop); {compute clipped X location}
  170.     end; {case}
  171.   end;
  172.  
  173.  
  174.  
  175.   {----------------------------------------------------}
  176.   {point the pupils at the indicated screen location}
  177.   procedure LookAt(var EyeData:EyeDataRec; Xp,Yp:integer);
  178.   begin
  179.     with EyeData do
  180.     begin
  181.       TPexl := Map(Style,Lesx,Lecx,Leex,GetMaxX,Xp);
  182.       TPeyl := Map(Style,Lesy,Lecy,Leey,GetMaxY,Yp);
  183.       TPexr := Map(Style,Resx,Recx,Reex,GetMaxX,Xp);
  184.       TPeyr := Map(Style,Resy,Recy,Reey,GetMaxY,Yp);
  185.  
  186.       {if the pupil location changed update the pupils}
  187.       if (TPexl<>Pexl) or (TPeyl<>Peyl) or (TPexr<>Pexr) or (TPeyr<>Peyr) then
  188.       begin
  189.         HideMouse;
  190.         SetFillStyle(SolidFill,BColor);  {restore eye background}
  191.         SetColor(BColor);
  192.         FillEllipse(Pexl,Peyl,Bpsx,Bpsy);
  193.         FillEllipse(Pexr,Peyr,Bpsx,Bpsy);
  194.         Pexl := TPexl;
  195.         Peyl := TPeyl;
  196.         Pexr := TPexr;
  197.         Peyr := TPeyr;
  198.         SetFillStyle(Solidfill,PColor);  {draw new pupil}
  199.         SetColor(PColor);
  200.         FillEllipse(Pexl,Peyl,Bpsx,Bpsy);
  201.         FillEllipse(Pexr,Peyr,Bpsx,Bpsy);
  202.         ShowMouse;
  203.       end;
  204.     end;
  205.   end;
  206.  
  207.  
  208. {----------------------------------------------------}
  209. {no initialization}
  210. end.
  211.  
  212.